home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.0 / stk-3 / blt-for-STk-3.0 / blt-1.9 / demos / calendar < prev    next >
Encoding:
Text File  |  1995-07-01  |  2.7 KB  |  91 lines
  1. #!../blt_wish -f
  2.  
  3. if [file exists ../library] {
  4.     set blt_library ../library
  5. }
  6. option add *Calendar.Frame.borderWidth 2
  7. option add *Calendar.Frame.relief raised
  8. option add *Calendar.Label.font *-Helvetica-Bold-R-*-14-*
  9. option add *Calendar*background steelblue
  10. option add *Calendar*foreground white
  11.  
  12. set monthInfo(Jan) { January 31 }
  13. set monthInfo(Feb) { February 28 } 
  14. set monthInfo(Mar) { March 31 } 
  15. set monthInfo(Apr) { April 30 } 
  16. set monthInfo(May) { May 31 } 
  17. set monthInfo(Jun) { June 30 } 
  18. set monthInfo(Jul) { July 31 }
  19. set monthInfo(Aug) { August 31 }
  20. set monthInfo(Sep) { September 30 }
  21. set monthInfo(Oct) { October 31 }
  22. set monthInfo(Nov) { November 30 }
  23. set monthInfo(Dec) { December 31 }
  24.  
  25. set abbrDays { Sun Mon Tue Wed Thu Fri Sat }
  26.  
  27. proc Calendar { weekday day month year } {
  28.     global monthInfo abbrDays 
  29.     
  30.     set wkdayOffset [lsearch $abbrDays $weekday]
  31.     if { $wkdayOffset < 0 } {
  32.     error "Invalid week day \"$weekday\""
  33.     }
  34.     set dayOffset [expr ($day-1)%7]
  35.     if { $wkdayOffset < $dayOffset } {
  36.     set wkdayOffset [expr $wkdayOffset+7]
  37.     }
  38.     set wkday [expr $wkdayOffset-$dayOffset]
  39.     if { [info commands .calendar] == ".calendar" } {
  40.     destroy .calendar 
  41.     }
  42.     frame .calendar -class Calendar
  43.     if ![info exists monthInfo($month)] {
  44.     error "Invalid month \"$month\""
  45.     }
  46.     set info $monthInfo($month)
  47.     label .calendar.month \
  48.     -text "[lindex $info 0] $year"  \
  49.     -font *-New*Century*Schoolbook-Bold-R-*-18-* 
  50.     blt_table .calendar .calendar.month 1,1 -cspan 7 
  51.  
  52.     set cnt 1
  53.     frame .calendar.weekframe -relief sunken -bd 2
  54.     blt_table .calendar .calendar.weekframe 2,0 -columnspan 8 -fill both  
  55.     foreach dayName $abbrDays {
  56.     set name [string tolower $dayName]
  57.     label .calendar.$name \
  58.         -text $dayName \
  59.         -font *-New*Century*Schoolbook-Bold-R-*-14-* 
  60.     blt_table .calendar .calendar.$name 2,$cnt -pady 2 -padx 2
  61.     incr cnt
  62.     }
  63.     blt_table column .calendar configure all -padx 4 
  64.     blt_table column .calendar configure 0 -width 0 
  65.     blt_table row .calendar configure 2 -pady 4 
  66.     set week 0
  67.     set numDays [lindex $info 1]
  68.     for { set cnt 1 } { $cnt <= $numDays } { incr cnt } {
  69.     label .calendar.day${cnt} -text $cnt
  70.     if { $cnt == $day } {
  71.         .calendar.day${cnt} configure -relief raised 
  72.     }
  73.     if { $wkday == 7 } {
  74.         incr week
  75.         set wkday 0
  76.     }
  77.     incr wkday
  78.     blt_table .calendar .calendar.day${cnt} $week+3,$wkday -fill both
  79.     }
  80.     button .calendar.quit -command { destroy . } -text {Quit}
  81.     blt_table .calendar \
  82.     .calendar.quit $week+4,6 -cspan 2 -ipadx 10 -pady 4 -ipady 2 -anchor e 
  83.     pack append . .calendar {fill expand frame center}
  84. }
  85.  
  86. set date [exec date]
  87. scan $date {%s %s %d %*s %*s %s} weekday month day year
  88.  
  89. Calendar $weekday $day $month $year
  90. wm minsize . 0 0
  91.